home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / attr.fr_ / attr.fr
Text File  |  1995-07-19  |  7KB  |  213 lines

  1. VERSION 4.00
  2. Begin VB.Form frmAttributes 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Attributes"
  6.    ClientHeight    =   3090
  7.    ClientLeft      =   1065
  8.    ClientTop       =   1455
  9.    ClientWidth     =   7560
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    Height          =   3495
  20.    Left            =   1005
  21.    LinkTopic       =   "Form1"
  22.    MaxButton       =   0   'False
  23.    ScaleHeight     =   3090
  24.    ScaleWidth      =   7560
  25.    Top             =   1110
  26.    Width           =   7680
  27.    Begin VB.CommandButton cmdQuit 
  28.       Caption         =   "&Quit"
  29.       Default         =   -1  'True
  30.       Height          =   375
  31.       Left            =   6360
  32.       TabIndex        =   3
  33.       Top             =   2520
  34.       Width           =   975
  35.    End
  36.    Begin VB.TextBox txtFuncCount 
  37.       BackColor       =   &H00C0C0C0&
  38.       Height          =   285
  39.       Left            =   1920
  40.       TabIndex        =   4
  41.       TabStop         =   0   'False
  42.       Top             =   2640
  43.       Width           =   855
  44.    End
  45.    Begin VB.ListBox lstFunctions 
  46.       BackColor       =   &H00C0C0C0&
  47.       Height          =   1980
  48.       Left            =   240
  49.       TabIndex        =   1
  50.       Top             =   480
  51.       Width           =   2535
  52.    End
  53.    Begin MSGrid.Grid grdGI 
  54.       Height          =   2175
  55.       Left            =   3000
  56.       TabIndex        =   2
  57.       Top             =   240
  58.       Width           =   4335
  59.       _version        =   65536
  60.       _extentx        =   7646
  61.       _extenty        =   3836
  62.       _stockprops     =   77
  63.       fixedcols       =   0
  64.       scrollbars      =   2
  65.    End
  66.    Begin VB.Label Label1 
  67.       BackColor       =   &H00C0C0C0&
  68.       Caption         =   "Functions Available:"
  69.       Height          =   255
  70.       Left            =   240
  71.       TabIndex        =   0
  72.       Top             =   240
  73.       Width           =   2535
  74.    End
  75.    Begin VB.Label lblFuncCount 
  76.       Alignment       =   1  'Right Justify
  77.       BackColor       =   &H00C0C0C0&
  78.       Caption         =   "Total Functions:"
  79.       Height          =   255
  80.       Left            =   240
  81.       TabIndex        =   5
  82.       Top             =   2640
  83.       Width           =   1575
  84.    End
  85. End
  86. Attribute VB_Name = "frmAttributes"
  87. Attribute VB_Creatable = False
  88. Attribute VB_Exposed = False
  89. Option Explicit
  90.  
  91. Private Sub cmdQuit_Click()
  92.     Unload frmAttributes
  93. End Sub
  94.  
  95. Private Function convCh(inChar As String, num As Variant)
  96.     inChar = LTrim$(Left$(inChar, num))
  97.  
  98.     Select Case inChar
  99.         Case "Y"
  100.             convCh = "Yes"
  101.         Case "N"
  102.             convCh = "No"
  103.         Case Else
  104.             convCh = inChar
  105.     End Select
  106.  
  107. End Function
  108.  
  109. Private Sub Form_Load()
  110.     'Resize data here
  111.     grdGI.ColWidth(0) = grdGI.Width / 2
  112.     grdGI.ColWidth(1) = grdGI.Width / 2
  113.  
  114.     grdGI.ColAlignment(0) = 1
  115.     grdGI.ColAlignment(1) = 0
  116.  
  117.     grdGI.Row = 0
  118.     grdGI.Col = 0
  119.     grdGI.text = "Property"
  120.     grdGI.Col = 1
  121.     grdGI.text = "Value"
  122.     
  123.     grdGI.FixedAlignment(0) = 2
  124.     grdGI.FixedAlignment(1) = 2
  125.  
  126.     grdGI.HighLight = False
  127.  
  128.     'Other setup chores
  129.     frmAttributes.Top = 1.5 * frmODBC.Top
  130.     frmAttributes.Left = 1.5 * frmODBC.Left
  131.  
  132.     'Load other data source information
  133.     ODBCInfo
  134.  
  135. End Sub
  136.  
  137. Private Sub ODBCInfo()
  138.     Dim fInfoType As Integer
  139.     
  140.     'return values
  141.     Dim ri As Integer
  142.     Dim rs As String * 255
  143.  
  144.     Dim rgbInfoValue As Long
  145.     Dim cbInfoValueMax As Integer
  146.     #If Win32 Then
  147.         Dim pcbInfoValue As Long
  148.     #Else
  149.         Dim pcbInfoValue As Integer
  150.     #EndIf
  151.     Dim result As Integer
  152.     Dim temp As String
  153.     cbInfoValueMax = 255
  154.     
  155.     result = SQLGetInfo(ghDbc, SQL_ACTIVE_CONNECTIONS, ri, cbInfoValueMax, pcbInfoValue)
  156.     If result <> SQL_ERROR Then
  157.         grdGI.AddItem "Maximum Connections " & Chr$(9) & IIf(ri = 0, "Unknown", LTrim$(Str$(ri)))
  158.     End If
  159.     result = SQLGetInfo(ghDbc, SQL_DATA_SOURCE_READ_ONLY, ByVal rs, cbInfoValueMax, pcbInfoValue)
  160.     If result <> SQL_ERROR Then
  161.         grdGI.AddItem "Data: read only? " & Chr$(9) & convCh(rs, pcbInfoValue)
  162.     End If
  163.     result = SQLGetInfo(ghDbc, SQL_DBMS_NAME, ByVal rs, cbInfoValueMax, pcbInfoValue)
  164.     If result <> SQL_ERROR Then
  165.         grdGI.AddItem "DBMS Name " & Chr$(9) & convCh(rs, pcbInfoValue)
  166.     End If
  167.     result = SQLGetInfo(ghDbc, SQL_DBMS_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
  168.     If result <> SQL_ERROR Then
  169.         grdGI.AddItem "DBMS Version " & Chr$(9) & convCh(rs, pcbInfoValue)
  170.     End If
  171.     result = SQLGetInfo(ghDbc, SQL_DRIVER_NAME, ByVal rs, cbInfoValueMax, pcbInfoValue)
  172.     If result <> SQL_ERROR Then
  173.         grdGI.AddItem "DBMS Driver Name " & Chr$(9) & convCh(rs, pcbInfoValue)
  174.     End If
  175.     result = SQLGetInfo(ghDbc, SQL_DRIVER_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
  176.     If result <> SQL_ERROR Then
  177.         grdGI.AddItem "DBMS Driver Version " & Chr$(9) & convCh(rs, pcbInfoValue)
  178.     End If
  179.     result = SQLGetInfo(ghDbc, SQL_DRIVER_ODBC_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
  180.     If result <> SQL_ERROR Then
  181.         grdGI.AddItem "Driver ODBC Version " & Chr$(9) & convCh(rs, pcbInfoValue)
  182.     End If
  183.     result = SQLGetInfo(ghDbc, SQL_ODBC_API_CONFORMANCE, ri, cbInfoValueMax, pcbInfoValue)
  184.     If result <> SQL_ERROR Then
  185.         Select Case ri
  186.             Case SQL_OAC_NONE
  187.                 temp = "Core Only"
  188.             Case SQL_OAC_LEVEL1
  189.                 temp = "Level 1"
  190.             Case SQL_OAC_LEVEL2
  191.                 temp = "Level 2"
  192.         End Select
  193.         grdGI.AddItem "ODBC Conformance Level " & Chr$(9) & temp
  194.     End If
  195.     result = SQLGetInfo(ghDbc, SQL_ODBC_SQL_CONFORMANCE, ri, cbInfoValueMax, pcbInfoValue)
  196.     If result <> SQL_ERROR Then
  197.         Select Case ri
  198.             Case SQL_OSC_MINIMUM
  199.                 temp = "Minimum Grammar"
  200.             Case SQL_OSC_CORE
  201.                 temp = "Core Grammar"
  202.             Case SQL_OSC_EXTENDED
  203.                 temp = "Extended Grammar"
  204.         End Select
  205.         grdGI.AddItem "SQL Grammar Level " & Chr$(9) & temp
  206.     End If
  207.  
  208.     If grdGI.Rows > 2 Then
  209.         grdGI.RemoveItem 1
  210.     End If
  211. End Sub
  212.  
  213.